perm filename SIMULA.LSP[SYS,HE] blob sn#546973 filedate 1982-09-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00020 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	 load up files for compilation
C00004 00003	Declarations for the compiler.
C00005 00004	(DEFUN AUTOLD-BIS-SIMULA () NIL)
C00006 00005	clip-time[]
C00007 00006	cmd-*[] doubles $TIME-STEP
C00008 00007	cmd-//[] halves $TIME-STEP
C00009 00008	cmd-a[] skips to the beginning
C00010 00009	cmd-b[] plays backward by 1 step or by # steps
C00013 00010	cmd-f[] plays forward by 1 step or by # steps
C00015 00011	cmd-g[] skips to a given time
C00016 00012	cmd-sf[] skips forward by 1 step or by # steps
C00017 00013	cmd-step[] tells or sets $TIME-STEP
C00018 00014	cmd-time[] reports $TIME.
C00019 00015	cmd-time-hi[]
C00020 00016	cmd-time-lo[]
C00021 00017	cmd-z[]
C00022 00018	compute-time-dependencies[]
C00023 00019	make-time-dependent[exp]
C00024 00020	make-time-independent[exp]
C00025 ENDMK
C⊗;
;;; load up files for compilation

(EVAL-WHEN (COMPILE)
	   (OR (BOUNDP '|.loaded.|) (FASLOAD LOADER FAS DSK (SYS ROD)))
	   (LOADUP (RECORD FAS DSK (SYS ROD))
		   (USEDEC LSP DSK (SYS ROD))
		   (DECLAR LSP DSK (SYS ROD))
		   (GRAPHS LSP DSK (SYS ROD))
		   (BISUTL LSP DSK (SYS BIS))))
;Declarations for the compiler.

(DEFUN AUTOLD-BIS-SIMULA () NIL)
;clip-time[]
;clips $TIME so that
;	$TIME-LO < $TIME < $TIME-HI
 
(DEFUN CLIP-TIME ()
       (COND
	((> $TIME $TIME-HI)
	 (SETQ $TIME $TIME-HI)
	 (WRITELN '|$TIME clipped to $TIME-HI = | $TIME-HI))
	((< $TIME $TIME-LO)
	 (SETQ $TIME $TIME-LO)
	 (WRITELN '|$TIME clipped to $TIME-LO = | $TIME-LO))
	(T NIL))
       )   ;end-defun
;cmd-*[] doubles $TIME-STEP
 
(DEFUN CMD-* ()
       (SETQ $TIME-STEP (* $TIME-STEP 2))
       )   ;end-defun
;cmd-//[] halves $TIME-STEP
 
(DEFUN CMD-// ()
       (SETQ $TIME-STEP (// $TIME-STEP 2))
       )   ;end-defun
;cmd-a[] skips to the beginning
 
(DEFUN CMD-A ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (IF (OR $NUMBER-BUFFER $SIGN-BUFFER)
	       THEN (WRITELN '|Illegal:  +zA or -zA or #zA or +#zA or -#zA|)
	       ELSE
	       (SETQ $TIME $TIME-LO)
	       (WRITELN '|TIME=| $TIME)
	       (COMPUTE-TIME-DEPENDENCIES)
	       (EVAL $DOSTUFF)))
       )   ;end-defun
;cmd-b[] plays backward by 1 step or by # steps

(DEFUN CMD-B ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN T ELSE NIL)
		N ← (IF (NULL $NUMBER-BUFFER)
			THEN 1
			ELSE (COMPRESS-NUMBER-BUFFER))
		THEN BACKWARD ← (NOT FORWARD)
		DO
		(COND
		 ((AND BACKWARD (= $TIME $TIME-LO))
		  (BEEP)
		  (WRITELN '|You're at the end!  $TIME-LO = | $TIME-LO))
		 ((AND FORWARD (= $TIME $TIME-HI))
		  (BEEP)
		  (WRITELN '|You're at the end!  $TIME-HI = | $TIME-HI))
		 (T
		  (DO ((I 0 (1+ I)))
		      ((OR (= I N)
			   (AND BACKWARD (= $TIME $TIME-LO))
			   (AND FORWARD (= $TIME $TIME-HI))) NIL)
		      (SETQ $TIME
			    (IF FORWARD THEN (+ $TIME $TIME-STEP)
				ELSE (- $TIME $TIME-STEP)))
		      (CLIP-TIME)
		      (WRITELN '|TIME=| $TIME)
		      (COMPUTE-TIME-DEPENDENCIES)
		      (EVAL $DOSTUFF))))))
	   )   ;end-defun
;cmd-f[] plays forward by 1 step or by # steps

(DEFUN CMD-F ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN NIL ELSE T)
		N ← (IF (NULL $NUMBER-BUFFER)
			THEN 1
			ELSE (COMPRESS-NUMBER-BUFFER))
		THEN BACKWARD ← (NOT FORWARD)
		DO
		(COND
		 ((AND BACKWARD (= $TIME $TIME-LO))
		  (BEEP)
		  (WRITELN '|You're at the end!  $TIME-LO = | $TIME-LO))
		 ((AND FORWARD (= $TIME $TIME-HI))
		  (BEEP)
		  (WRITELN '|You're at the end!  $TIME-HI = | $TIME-HI))
		 (T
		  (DO ((I 0 (1+ I)))
		      ((OR (= I N)
			   (AND BACKWARD (= $TIME $TIME-LO))
			   (AND FORWARD (= $TIME $TIME-HI))) NIL)
		      (SETQ $TIME
			    (IF FORWARD THEN (+ $TIME $TIME-STEP)
				ELSE (- $TIME $TIME-STEP)))
		      (CLIP-TIME)
		      (WRITELN '|TIME=| $TIME)
		      (COMPUTE-TIME-DEPENDENCIES)
		      (EVAL $DOSTUFF))))))
       )   ;end-defun
;cmd-g[] skips to a given time
 
(DEFUN CMD-G ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (IF $SIGN-BUFFER
	       THEN (WRITELN '|Illegal:  +#zG or -#zG|)
	       ELSE
	       (IF (NULL $NUMBER-BUFFER)
		   THEN (WRITELN '|Illegal:  # must be supplied to zG|)
		   ELSE
		   (SETQ $TIME (COMPRESS-NUMBER-BUFFER))
		   (CLIP-TIME)
		   (WRITELN '|$TIME = | $TIME)
		   (COMPUTE-TIME-DEPENDENCIES)
		   (EVAL $DOSTUFF))))
       )   ;end-defun
;cmd-sf[] skips forward by 1 step or by # steps

(DEFUN CMD-SF ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN NIL ELSE T)
		N ← (IF (NULL $NUMBER-BUFFER)
			THEN 1
			ELSE (COMPRESS-NUMBER-BUFFER))
		DO
		(SETQ $TIME
		      (IF FORWARD THEN (+ $TIME (* N $TIME-STEP))
			  ELSE (- $TIME (* N $TIME-STEP)))))
	   (CLIP-TIME)
	   (WRITELN '|TIME=| $TIME)
	   (COMPUTE-TIME-DEPENDENCIES)
	   (EVAL $DOSTUFF))
       )   ;end-defun
;cmd-step[] tells or sets $TIME-STEP

(DEFUN CMD-STEP ()
       (IF (NULL $SIGN-BUFFER)
	   THEN (LET N ← (COMPRESS-NUMBER-BUFFER)
		     DO (IF (= 0 N) THEN (WRITELN '|$TIME-STEP=| $TIME-STEP)
			    ELSE (SETQ $TIME-STEP N)))
	   ELSE (IF (NULL $NUMBER-BUFFER)
		    THEN (WRITELN '|Illegal:  +zSTEP or -zSTEP|)
		    ELSE (LET N ← (COMPRESS-NUMBER-BUFFER) DO
			      (SETQ $TIME-STEP
				    (IF (EQ '- $SIGN-BUFFER)
					THEN (MAX 0 (- $TIME-STEP N))
					ELSE (+ $TIME-STEP N))))))
       )   ;end-defun
;cmd-time[] reports $TIME.
 
(DEFUN CMD-TIME ()
       (WRITELN '|$TIME = | $TIME)
       )   ;end-defun
;cmd-time-hi[]
;sets $TIME-HI.
 
(DEFUN CMD-TIME-HI ()
       (IF (NULL $NUMBER-BUFFER)
	   THEN
	   (WRITELN '|$TIME-HI = | $TIME-HI)
	   ELSE
	   (LET N ← (COMPRESS-NUMBER-BUFFER)
		THEN
		N ← (IF (= $SIGN-BUFFER '-)
			THEN (- N)
			ELSE N)
		DO
		(SETQ $TIME-HI N)
		(WRITELN '|$TIME-HI = | $TIME-HI)))
       )   ;end-defun
;cmd-time-lo[]
;sets $TIME-LO.
 
(DEFUN CMD-TIME-LO ()
       (IF (NULL $NUMBER-BUFFER)
	   THEN
	   (WRITELN '|$TIME-LO = | $TIME-LO)
	   ELSE
	   (LET N ← (COMPRESS-NUMBER-BUFFER)
		THEN
		N ← (IF (= $SIGN-BUFFER '-)
			THEN (- N)
			ELSE N)
		DO
		(SETQ $TIME-LO N)
		(WRITELN '|$TIME-LO = | $TIME-LO)))
       )   ;end-defun
;cmd-z[]
 
(DEFUN CMD-Z ()
       (IF (NOT $TIME-DEPENDENCIES)
	   THEN
	   (BEEP)
	   (WRITELN '|Sorry, but nothing is currently time-dependent.|)
	   ELSE
	   (IF (OR $NUMBER-BUFFER $SIGN-BUFFER)
	       THEN
	       (WRITELN '|Illegal:  +zZ or -zZ or #zZ or +#zZ or -#zZ|)
	       ELSE
	       (SETQ $TIME $TIME-HI)
	       (WRITELN '|TIME=| $TIME)
	       (COMPUTE-TIME-DEPENDENCIES)
	       (EVAL $DOSTUFF)))
       )   ;end-defun
;compute-time-dependencies[]
;EVALs all expressions on the list $TIME-DEPENDENCIES.
 
(DEFUN COMPUTE-TIME-DEPENDENCIES ()
       (FOR EXP ε $TIME-DEPENDENCIES
	    DO
	    (EVAL EXP))
       )   ;end-defun
;make-time-dependent[exp]
;causes EXP to be EVALed whenever $TIME is changed.
 
(DEFUN MAKE-TIME-DEPENDENT (EXP)
       (IF (NOT (MEMBER EXP $TIME-DEPENDENCIES))
	   THEN
	   (SETQ $TIME-DEPENDENCIES (CONS EXP $TIME-DEPENDENCIES)))
       )   ;end-defun
;make-time-independent[exp]
;undoes the MAKE-TIME-DEPENDENT function.
 
(DEFUN MAKE-TIME-INDEPENDENT (EXP)
       (IF (NOT (MEMBER EXP $TIME-DEPENDENCIES))
	   THEN
	   (WRITELN '|Sorry, but `|
		    EXP
		    '|' is NOT time-dependent.|)
	   ELSE
	   (SETQ $TIME-DEPENDENCIES (DELETE EXP $TIME-DEPENDENCIES)))
       )   ;end-defun